home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / surfsrc3.zip / SHELLPTS.INC < prev    next >
Text File  |  1989-08-10  |  3KB  |  85 lines
  1. procedure SHELLPTS (var Xpt, Ypt: points; Npts: integer);
  2.  
  3. { Shell sort the line point data, using Ypt as the primary sorting
  4.   criterion and Xpt as the secondary (tie-breaking) sorting
  5.   criterion. Procedure as published in Tanenbaum, "Structured
  6.   Computer Organization", Prentice-Hall, Englewood Cliffs, NJ, 1976.
  7. }
  8. var Dist: integer;              { sorting distance }
  9.     K, I: integer;              { genl sorting indexes }
  10.  
  11. begin
  12.  
  13. { Determine the initial value of Dist by finding the largest power
  14.   of 2 less than Npts, and subtracting 1 from it. The final step in
  15.   this calculation is performed inside the main sorting loop.
  16. }
  17.   Dist := 4;
  18.   while (Dist < Npts) do
  19.     Dist := Dist + Dist;
  20.   Dist := Dist - 1;
  21.  
  22. { Main sorting loop. The outer loop is executed once per pass. }
  23.   while (Dist > 1) do begin
  24.     Dist := Dist div 2;
  25.     for K := 1 to (Npts - Dist) do begin
  26.       I := K;
  27.       while (I > 0) do begin
  28.         { This stmt. is the comparison. It also controls moving values
  29.           upward after an exchange. }
  30.         if (Ypt[I] > Ypt[I+Dist]) or
  31.           ((Ypt[I] = Ypt[I+Dist]) and (Xpt[I] > Xpt[I+Dist])) then begin
  32.           { The next 2 stmts. perform the exchange }
  33.           swapint (Xpt[I], Xpt[I+Dist]);
  34.           swapint (Ypt[I], Ypt[I+Dist]);
  35.         end else
  36.           I := 0;      { stop the while loop! }
  37.         I := I - Dist;
  38.       end; { while }
  39.     end; { for K }
  40.   end; { while Dist }
  41. end; { procedure SHELLPTS }
  42.  
  43. procedure SHELLSHADES (var Xpt, Ypt: points; var Shpt: realpts; Npts: integer);
  44.  
  45. { Shell sort the line point & shade data, using Ypt as the primary sorting
  46.   criterion and Xpt as the secondary (tie-breaking) sorting
  47.   criterion. Procedure as published in Tanenbaum, "Structured
  48.   Computer Organization", Prentice-Hall, Englewood Cliffs, NJ, 1976.
  49. }
  50. var Dist: integer;              { sorting distance }
  51.     K, I: integer;              { genl sorting indexes }
  52.  
  53. begin
  54.  
  55. { Determine the initial value of Dist by finding the largest power
  56.   of 2 less than Npts, and subtracting 1 from it. The final step in
  57.   this calculation is performed inside the main sorting loop.
  58. }
  59.   Dist := 4;
  60.   while (Dist < Npts) do
  61.     Dist := Dist + Dist;
  62.   Dist := Dist - 1;
  63.  
  64. { Main sorting loop. The outer loop is executed once per pass. }
  65.   while (Dist > 1) do begin
  66.     Dist := Dist div 2;
  67.     for K := 1 to (Npts - Dist) do begin
  68.       I := K;
  69.       while (I > 0) do begin
  70.         { This stmt. is the comparison. It also controls moving values
  71.           upward after an exchange. }
  72.         if (Ypt[I] > Ypt[I+Dist]) or
  73.           ((Ypt[I] = Ypt[I+Dist]) and (Xpt[I] > Xpt[I+Dist])) then begin
  74.           { The next 2 stmts. perform the exchange }
  75.           swapint (Xpt[I], Xpt[I+Dist]);
  76.           swapint (Ypt[I], Ypt[I+Dist]);
  77.           swapreal (Shpt[I], Shpt[I+Dist]);
  78.         end else
  79.           I := 0;      { stop the while loop! }
  80.         I := I - Dist;
  81.       end; { while }
  82.     end; { for K }
  83.   end; { while Dist }
  84. end; { procedure SHELLSHADES }
  85.